home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 1 / Gold Medal Software Volume 1 (Gold Medal) (1994).iso / prog / tpwprog7.arj / SCAN.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-07-02  |  7.5 KB  |  281 lines
  1. { scan.pas -- Scan hard drive and report file statistics }
  2.  
  3. {$M 16384, 8192}
  4.  
  5. program Scan;
  6.  
  7. {$R scan.res}
  8.  
  9. uses WinDOS, WinTypes, WinProcs, WObjects, Strings, StdDlgs, Status;
  10.  
  11. const
  12.  
  13.   id_Menu  = 100;    { Menu resource ID }
  14.   cm_Scan  = 101;    { Command IDs }
  15.   cm_Exit  = 102;
  16.  
  17. type
  18.  
  19.   DataType = (dtNumFiles, dtNumDirectories, dtMaxLevel,
  20.     dtSmallestFile, dtLargestFile, dtAvgFileSize,
  21.     dtDiskSize, dtFileBytes, dtBytesFree);
  22.  
  23. const
  24.  
  25.   FirstDataType = dtNumFiles;
  26.   LastDataType = dtBytesFree;
  27.   LabelArray: array[DataType] of PChar = (
  28.     'Number of nonnull files: ',
  29.     'Number of directories: ',
  30.     'Maximum directory level: ',
  31.     'Smallest file in bytes: ',
  32.     'Largest file in bytes: ',
  33.     'Average file size in bytes: ',
  34.     'Disk size in bytes: ',
  35.     'Bytes used by files: ',
  36.     'Total bytes free: '
  37.   );
  38.  
  39. type
  40.  
  41.   ScanApplication = object(TApplication)
  42.     procedure InitMainWindow; virtual;
  43.   end;
  44.  
  45.   PScanWindow = ^ScanWindow;
  46.   ScanWindow = object(TWindow)
  47.     Drive: Char;        { Drive letter }
  48.     Scanning: Boolean;  { True while scan is in progress }
  49.     DataArray: array[DataType] of LongInt;
  50.     LargestPath, SmallestPath: array[0 .. fsPathName] of Char;
  51.     StatusDialog: PStatus;
  52.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  53.     function CanClose: Boolean; virtual;
  54.     procedure ZeroFields;
  55.     function ScanDrive(D: Char): Boolean;
  56.     procedure CMScan(Msg: TMessage);
  57.       virtual cm_First + cm_Scan;
  58.     procedure CMQuit(Msg: TMessage);
  59.       virtual cm_First + cm_Exit;
  60.     procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
  61.       virtual;
  62.   end;
  63.  
  64.  
  65. { ScanApplication }
  66.  
  67. {- Initialize ScanApplication object's window }
  68. procedure ScanApplication.InitMainWindow;
  69. begin
  70.   MainWindow := New(PScanWindow, Init(nil, ''))
  71. end;
  72.  
  73.  
  74. { ScanWindow }
  75.  
  76. {- Construct ScanWindow object }
  77. constructor ScanWindow.Init(AParent: PWindowsObject; ATitle: PChar);
  78. begin
  79.   TWindow.Init(AParent, ATitle);
  80.   with Attr do
  81.   begin
  82.     Menu := LoadMenu(HInstance, PChar(id_Menu));
  83.     X := 10; Y := 10; W := 350; H := 400
  84.   end;
  85.   StatusDialog := nil;
  86.   Scanning := false;
  87.   ZeroFields
  88. end;
  89.  
  90. {- Return true if main window may be closed }
  91. function ScanWindow.CanClose: Boolean;
  92. begin
  93.   CanClose := not Scanning
  94. end;
  95.  
  96. {- Set data fields to zero }
  97. procedure ScanWindow.ZeroFields;
  98. begin
  99.   Drive := #0;
  100.   FillChar(DataArray, Sizeof(DataArray), 0);
  101.   LargestPath[0] := #0;
  102.   SmallestPath[0] := #0
  103. end;
  104.  
  105. {- Scan drive and update statistics. Return true for success }
  106. {  Requires initialized StatusDialog object pointer }
  107. function ScanWindow.ScanDrive(D: Char): Boolean;
  108. var
  109.   P: PChar;
  110.  
  111.   {- Read file and path names recursively }
  112.   procedure ReadDirectory(Level: Integer);
  113.   var
  114.     Sr: TSearchRec;        { Directory search record }
  115.     LocalDir: array[0 .. fsDirectory] of Char;  { Current path }
  116.     LocalName: array[0 .. fsPathName] of Char;  { Current dir + file }
  117.     IsFileEntry: Boolean;  { True except for '.' and '..' }
  118.   begin
  119.     Inc(DataArray[dtNumDirectories]);
  120.     if Level > DataArray[dtMaxLevel] then
  121.       DataArray[dtMaxLevel] := Level;
  122.     LocalDir[0] := #0;
  123.     GetCurDir(LocalDir, 0);
  124.     StatusDialog^.Update1(LocalDir);
  125.     FindFirst('*.*', faAnyFile, Sr);
  126.     while (DosError = 0) and (StatusDialog^.Continue) do with Sr do
  127.     begin
  128.       IsFileEntry := Name[0] <> '.';
  129.       if IsFileEntry and (Attr and faDirectory <> 0) then
  130.       begin
  131.         SetCurDir(Name);           { Change to next level }
  132.         ReadDirectory(Level + 1);  { Process files there }
  133.         SetCurDir('..')            { Return to previous level }
  134.       end else if IsFileEntry and (Size > 0) then
  135.       begin
  136.         StatusDialog^.Update2(Name);
  137.         StrCopy(LocalName, LocalDir);
  138.         if LocalName[StrLen(LocalName) - 1] <> '\' then
  139.           StrCat(LocalName, '\');
  140.         StrCat(LocalName, Name);
  141.         Inc(DataArray[dtNumFiles]);
  142.         Inc(DataArray[dtFileBytes], Size);
  143.         if Size < DataArray[dtSmallestFile] then
  144.         begin
  145.           DataArray[dtSmallestFile] := Size;
  146.           StrCopy(SmallestPath, LocalName)
  147.         end;
  148.         if Size > DataArray[dtLargestFile] then
  149.         begin
  150.           DataArray[dtLargestFile] := Size;
  151.           StrCopy(LargestPath, LocalName)
  152.         end
  153.       end;
  154.       FindNext(Sr)
  155.     end
  156.   end;
  157.  
  158. begin
  159.   ZeroFields;
  160.   P := 'X:\';
  161.   P[0] := D;    { Replace 'X' with D }
  162.   SetCurDir(P);
  163.   if DosError <> 0 then ScanDrive := false else
  164.   begin
  165.     Scanning := true;  { Prevent window from closing }
  166.     StatusDialog^.BeginStatus('Scanning files...');
  167.     DataArray[dtSmallestFile] := maxLongInt;
  168.     DataArray[dtDiskSize] := DiskSize(0);
  169.     DataArray[dtBytesFree] := DiskFree(0);
  170.     ReadDirectory(0);
  171.     if DataArray[dtNumFiles] = 0 then
  172.       DataArray[dtSmallestFile] := 0
  173.     else
  174.       DataArray[dtAvgFileSize] :=
  175.         DataArray[dtFileBytes] div DataArray[dtNumFiles];
  176.     ScanDrive := StatusDialog^.Continue; { i.e. not canceled }
  177.     StatusDialog^.EndStatus;
  178.     Scanning := false  { Permit window to close }
  179.   end
  180. end;
  181.  
  182. {- Execute File:Scan command }
  183. procedure ScanWindow.CMScan(Msg: TMessage);
  184. var
  185.   Buffer: array[0 .. 2] of Char;
  186. begin
  187.   if Scanning then Exit;  { Only one scan at a time }
  188.   Buffer[0] := #0;
  189.   if Application^.ExecDialog(New(PInputDialog,
  190.     Init(@Self, 'Prompt', 'Enter letter of drive to scan: ',
  191.     Buffer, Sizeof(Buffer)))) = id_Ok then
  192.   if StrLen(Buffer) <> 0 then
  193.   begin
  194.     if StatusDialog = nil then
  195.     begin { Create new Scan status dialog }
  196.       StatusDialog := PStatus(
  197.         Application^.MakeWindow(New(PStatus, Init(@Self, statusID))));
  198.       if StatusDialog = nil then
  199.         Application^.Error(em_OutOfMemory)
  200.       else
  201.         StatusDialog^.ChangeTitle('File Scan Status')
  202.     end;
  203.     if StatusDialog <> nil then
  204.     begin
  205.       if ScanDrive(Buffer[0]) then
  206.         Drive := Upcase(Buffer[0]);
  207.       InvalidateRect(HWindow, nil, true)
  208.     end
  209.   end
  210. end;
  211.  
  212. {- Execute File:Exit command }
  213. procedure ScanWindow.CMQuit(Msg: TMessage);
  214. begin
  215.   CloseWindow
  216. end;
  217.  
  218. {- Paint contents of window. Displays current statistics. }
  219. procedure ScanWindow.Paint(PaintDC: HDC;
  220.   var PaintInfo: TPaintStruct);
  221. var
  222.   DT: DataType;
  223.   X, Y, YDelta: Integer;
  224.   S: String[11];
  225.   P: PChar;
  226.   Len: Word;
  227.   Extent: LongInt;
  228.  
  229.   {- Display pathname P and advance Y by YDelta }
  230.   procedure ShowPath(P: PChar);
  231.   begin
  232.     if (P <> nil) and (StrLen(P) > 0) then
  233.     begin
  234.       TextOut(PaintDC, X + 4, Y, P, StrLen(P));
  235.       Inc(Y, YDelta)
  236.     end
  237.   end;
  238.  
  239. begin
  240.   if Drive = #0 then
  241.     P := 'No drive selected'
  242.   else begin
  243.     P := 'Statistics for drive X:';
  244.     P[21] := Drive
  245.   end;
  246.   SetWindowText(HWindow, P);
  247.   Y := 10;
  248.   for DT := FirstDataType to LastDataType do
  249.   begin
  250.     X := 10;
  251.     P := LabelArray[DT];
  252.     Len := StrLen(P);
  253.     Extent := GetTextExtent(PaintDC, P, Len);
  254.     TextOut(PaintDC, X, Y, P, Len);
  255.     Str(DataArray[DT], S);
  256.     TextOut(PaintDC, X + LOWORD(Extent), Y, @S[1], Length(S));
  257.     YDelta := HIWORD(Extent * 2);
  258.     Inc(Y, YDelta);
  259.     if DT = dtSmallestFile then
  260.       ShowPath(SmallestPath)
  261.     else if DT = dtLargestFile then
  262.       ShowPath(LargestPath)
  263.   end;
  264. end;
  265.  
  266. var
  267.  
  268.   ScanApp: ScanApplication;
  269.  
  270. begin
  271.   ScanApp.Init('ScanApp');
  272.   ScanApp.Run;
  273.   ScanApp.Done
  274. end.
  275.  
  276.  
  277. {--------------------------------------------------------------
  278.   Copyright (c) 1991 by Tom Swan. All rights reserved.
  279.   Revision 1.00    Date: 5/4/1991
  280. ---------------------------------------------------------------}
  281.